home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / RESOURCE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-18  |  11KB  |  352 lines
  1. UNIT Resource;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Resource mamager                              Last changed: 20.04.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-95 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, OpRoot,
  16.      OproUtil;
  17.  
  18. CONST
  19.   { GetMenu Constants }
  20.   MnuMain          =  1;
  21.   MnuDTDialDir     =  2;
  22.   MnuAMInsertLine  =  3;
  23.   MnuAMMoveFile    =  4;
  24.   MnuAMGlobalFunc  =  5;
  25.   MnuCopyFileError =  6;
  26.   MnuOMSelMailType =  7;
  27.   MnuOMGlobalCmd   =  8;
  28.   MnuOMGetUpdType  =  9;
  29.   MnuOMSelSendAs   = 10;
  30.   MnuDTEmulation   = 11;
  31. { MnuMacros        = 12;  Udgået }
  32.   MnuNLInsNode     = 13;
  33.   MnuEventFlags    = 14;
  34.   MnuNlSearchOpt   = 15;
  35.  
  36.   MnuUEQBBSFlags   = 100;
  37.   MnuUEOPUS110Flags= 101;
  38.   MnuUEMaxFlags    = 102;
  39.  
  40.   { GetEsr Constants }
  41.   EsrMiscScreen      =  1;
  42.   EsrGlobalVal       =  2;
  43.   EsrArcSetup        =  3;
  44.   EsrDirAndFiles     =  4;
  45.   EsrMdmOptions      =  5;
  46.   EsrMatrixInfo      =  6;
  47.   EsrDumbTermSetup   =  7;
  48.   EsrDumbTermExt     =  8;
  49.   EsrNLCompSetup     =  9;
  50.   EsrConnectionSetup = 10;
  51.   EsrAreaManSetup    = 11;
  52.   EsrMultiBBSSetup   = 12;
  53.   EsrNetMailSetup    = 13;
  54.   EsrEchoMailSetup   = 14;
  55.   EsrMailScanMisc    = 15;
  56.   EsrFileFwdMisc     = 16;
  57.   EsrNLManager       = 17;
  58.   EsrReqLimits       = 18;
  59.   EsrNodesSetup      = 19;
  60.   EsrFileFwdSetup    = 20;
  61.   EsrOkFileSetup     = 21;
  62.   EsrTickSetup       = 22;
  63.   EsrMiscTickSetup   = 23;
  64.   EsrEventSetup      = 24;
  65.   EsrNodeListSeg     = 25;
  66.   EsrEchoAreas       = 26;
  67.   EsrListFiles       = 27;
  68.   EsrListFiles2      = 28;
  69.   EsrFuncKeys        = 29;
  70.   EsrScheduleSetup   = 30;
  71.   EsrNLTranslatSetup = 31;
  72.   EsrAdvMdmOptions   = 32;
  73.   EsrInboundToDoSetup= 33;
  74.   EsrMailScanParams  = 34;
  75.   EsrMFSSetup        = 35;
  76.   EsrPopEdHeader     = 36;
  77.   EsrMdmConnStat     = 37;
  78.  
  79. { ------ User editor ------ }
  80.  
  81.   EsrUserQBBSCombined = 100;
  82.   EsrUserMAXIMUSMain  = 101;
  83.   EsrUserQBBSMain     = 102;
  84.   EsrUserRAMain       = 103;
  85.   EsrUserOPUS110Main  = 104;
  86.   EsrUserLastRead     = 105;
  87.   EsrUserSBBSMain     = 106;
  88.   EsrUserSBBSExtra    = 107;
  89.  
  90. VAR
  91.   ResLib : OpLibrary;
  92.  
  93. PROCEDURE OpenResLib(CONST FName: PathStr);
  94. PROCEDURE CreateResLib(CONST FName: PathStr);
  95. PROCEDURE CloseResLib;
  96. PROCEDURE GetMenu(MNr, ColorLevel: Byte; VAR M: TPoPMenu);
  97. PROCEDURE GetEsr(ENr, ColorLevel: Byte; VAR Esr: TPoPEntryScreen);
  98. FUNCTION  GetString(CONST StrName: DirEntryName): String;
  99. PROCEDURE PutString(CONST StrName: DirEntryName; S: String);
  100. FUNCTION To3(B: Byte): String;
  101.  
  102. IMPLEMENTATION
  103.  
  104. USES OpCrt, OpString, OpEntry, OpMenu, OpField, OpSelect,
  105.      Nodelist, Globals, LogFile, Config, MailCfg, PoPHelp, UserEdit;
  106.  
  107. CONST
  108.   otStrLib = 1100;
  109.   veStrLib = 0;
  110.   ResLibOpen : Boolean = False;
  111.  
  112. TYPE
  113.   StrTypePtr = ^StrType;
  114.   StrType    = Object(Root)
  115.                  Str : String ;
  116.  
  117.                  CONSTRUCTOR Init(CONST St: String);
  118.                  CONSTRUCTOR Load(VAR S: IdStream);
  119.                  PROCEDURE Store(VAR S: IdStream);
  120.                END;
  121.  
  122.   CONSTRUCTOR StrType.Init(CONST St: String);
  123.   BEGIN
  124.     Str:=St;
  125.   END;
  126.  
  127.   CONSTRUCTOR StrType.Load(VAR S: IdStream);
  128.   BEGIN
  129.     IF Not Root.Init THEN Fail;
  130.     Str:=S.ReadString;
  131.     IF S.PeekStatus<>0 THEN Fail;
  132.   END;
  133.  
  134.   PROCEDURE StrType.Store(VAR S: IdStream);
  135.   BEGIN
  136.     S.WriteString(Str);
  137.   END;
  138.  
  139.   PROCEDURE StrLibStream(SPtr: IdStreamPtr); far;
  140.   BEGIN
  141.     SPtr^.RegisterType(otStrLib,veStrLib,TypeOf(StrType),@StrType.Store,@StrType.Load);
  142.   END;
  143.  
  144.   FUNCTION GetString(CONST StrName: DirEntryName): String;
  145.   VAR
  146.     St: StrType;
  147.   BEGIN
  148.     ResLib.GetEntry(StrName,St);
  149.     GetString:=St.Str;
  150.     St.Done;
  151.   END;
  152.  
  153.   PROCEDURE PutString(CONST StrName: DirEntryName; S: String);
  154.   VAR
  155.     St : StrType;
  156.   BEGIN
  157.     St.Init(S);
  158.     ResLib.PutEntry(StrName, St);
  159.     St.Done;
  160.   END;
  161.  
  162.   FUNCTION To3(B: Byte): String;
  163.   BEGIN
  164.     To3:=LongIntForm('@@@',b);
  165.   END;
  166.  
  167. {=== RESOURCE LIBRARY ===================================================}
  168.  
  169.   PROCEDURE OpenResLib(CONST FName: PathStr);
  170.   BEGIN
  171.     FileMode:=$20;
  172.     IF Not ResLib.Init(FName, $3D20, 1024,'POP-RES') THEN
  173.     BEGIN
  174.       WriteLn(FName+' not found Portal halted (Error code:',InitStatus,')');
  175.       Halt(255);
  176.     END;
  177.     ResLib.RegisterHier(TPoPMenuStream);
  178.     ResLib.RegisterHier(TPoPEntryScreenStream);
  179.     ResLib.RegisterHier(YesNoFieldStream);
  180.     ResLib.RegisterHier(TBitYesNoFieldStream);
  181.     ResLib.RegisterHier(TimeFieldStream);
  182.     ResLib.RegisterHier(ByteFieldStream);
  183.     ResLib.RegisterHier(ShortIntFieldStream);
  184.     ResLib.RegisterHier(WordFieldStream);
  185.     ResLib.RegisterHier(IntegerFieldStream);
  186. {$IFDEF OS2}
  187.     ResLib.RegisterHier(SmallWordFieldStream);
  188.     ResLib.RegisterHier(SmallIntFieldStream);
  189. {$ENDIF}
  190.     ResLib.RegisterHier(StringFieldStream);
  191.     ResLib.RegisterHier(CharFieldStream);
  192.     ResLib.RegisterHier(ChoiceFieldStream);
  193.     ResLib.RegisterHier(LongIntFieldStream);
  194.     ResLib.RegisterHier(TextFieldStream);
  195.     ResLib.RegisterHier(DateStFieldStream);
  196.     ResLib.RegisterHier(DateFieldStream);
  197.     ResLib.RegisterHier(StringDictStream);
  198.     ResLib.RegisterPointer(1000, @Cfg);
  199.     ResLib.RegisterPointer(1001, @Config.IncBBSType);
  200.     ResLib.RegisterPointer(1002, @Config.IncNodelist);
  201.     ResLib.RegisterPointer(1003, @NodelistEntry);
  202.     ResLib.RegisterPointer(1004, @Str2Bin);
  203.     ResLib.RegisterPointer(1005, @ValidateBin);
  204.     ResLib.RegisterPointer(1006, @BinConv);
  205.     ResLib.RegisterPointer(1007, @NodesRec);
  206.     ResLib.RegisterPointer(1008, @MailCfg.IncNodeStat);
  207.     ResLib.RegisterPointer(1009, @Config.IncModemType);
  208.     ResLib.RegisterPointer(1010, @MailCfg.IncFreeArea);
  209.     ResLib.RegisterPointer(1011, @CurrentEvent);
  210. {   ResLib.RegisterPointer(1012, @NodeListSegRec);}
  211.     ResLib.RegisterPointer(1013, @UserEdit.IncOPUSUserLevel);
  212.     ResLib.RegisterPointer(1014, @UserEdit.IncMaximusUserLevel);
  213.     ResLib.RegisterPointer(1015, @UserEdit.BinConv32);
  214.     ResLib.RegisterPointer(1016, @UserEdit.ValidateBin32);
  215. {   ResLib.RegisterPointer(1017, @UserEdit.Combined);
  216.     ResLib.RegisterPointer(1018, @UserEdit.UserRecord7);
  217.     ResLib.RegisterPointer(1019, @UserEdit.UserRecord1);
  218.     ResLib.RegisterPointer(1020, @UserEdit.UserRecord4);
  219.     ResLib.RegisterPointer(1021, @UserEdit.UserRecord3);}
  220. {    ResLib.RegisterPointer(1022, @AreasRec);}
  221.     ResLib.RegisterPointer(1023, @IncArcType);
  222.     ResLib.RegisterPointer(1024, @MailCfg.IncSCDAction);
  223.     ResLib.RegisterPointer(1025, @UserEdit.IncMaxHelpLevel);
  224.     ResLib.RegisterPointer(1026, @UserEdit.IncMaxVideoLevel);
  225.     ResLib.RegisterPointer(1027, @UserEdit.IncMaxProtocol);
  226.     ResLib.RegisterPointer(1028, @MailCfg.IncAKAUsed);
  227.     ResLib.RegisterPointer(1029, @Config.IncTaskType);
  228.     ResLib.RegisterPointer(1030, @Config.IncReqOnUs);
  229.     ResLib.RegisterHier(StrLibStream);
  230.     ResLibOpen:=True;
  231.   END;
  232.  
  233.   PROCEDURE CreateResLib(CONST FName: PathStr);
  234.   BEGIN
  235.     IF Not ResLib.Create(FName, 2048,'POP-RES',64) THEN
  236.     BEGIN
  237.       Halt(255);
  238.     END;
  239.     ResLib.RegisterHier(MenuStream);
  240.     ResLib.RegisterHier(EntryScreenStream);
  241.     ResLib.RegisterPointer(1000, @Cfg);
  242.   END;
  243.  
  244.   PROCEDURE CloseResLib;
  245.   BEGIN
  246.     IF ResLibOpen THEN
  247.     BEGIN
  248.       ResLib.Done;
  249.       ResLibOpen:=False;
  250.     END;
  251.   END;
  252.  
  253.   PROCEDURE GetMenu(MNr, ColorLevel: Byte; VAR M: TPoPMenu);
  254.   VAR
  255.     Offset : Byte;
  256.   BEGIN
  257.     ResLib.GetEntry('MNU'+To3(MNr),M);
  258.     M.UpdateScreenSize;
  259.     Offset:=(ScreenWidth-80) DIV 2;
  260.     M.MoveWindow(Offset, 0);
  261.     WITH Cfg.Color[ColorLevel] DO
  262.     BEGIN
  263.       M.SetAllFrameAttr(FrameColor,FrameMono);
  264.       M.SetAllHeaderAttr(HeaderColor,HeaderMono);
  265.       M.SetAllHighAttr(HighItemColor,HighItemMono);
  266.       M.SetAllNormAttr(TextColor,TextMono);
  267.       M.SetAllProtectAttr(ProItemColor,ProItemMono);
  268.       M.SetAllSelectAttr(SelItemColor,SelItemMono);
  269.       M.SetAllShadowAttr(ShadowColor,ShadowMono);
  270.     END;
  271.     IF Cfg.Screen.ExplodingWin THEN M.EnableAllExplosions(6) ELSE M.EnableNormalOpen;
  272.   END;
  273.  
  274.   PROCEDURE GetEsr(ENr, ColorLevel: Byte; VAR Esr: TPoPEntryScreen);
  275.  
  276.     PROCEDURE ResetEsrColors;
  277.     VAR
  278.       EFP : EntryFieldPtr;
  279.       TFP : TextFieldPtr;
  280.       CA, MA : FlexAttrs;
  281.     BEGIN
  282.       { B¢r ændres til VisitAll..... metode kald! }
  283.       EFP := EntryFieldPtr(Esr.asFields.Head);
  284.       WHILE EFP <> Nil DO
  285.         WITH EFP^ DO
  286.         BEGIN
  287.           sfCtrlColor := Cfg.Color[ColorLevel].CtrlColor;
  288.           sfCtrlMono := Cfg.Color[ColorLevel].CtrlMono;
  289.           sfProFieldColor := Cfg.Color[ColorLevel].ProFieldColor;
  290.           sfProFieldMono := Cfg.Color[ColorLevel].ProFieldMono;
  291.           sfSelFieldColor := Cfg.Color[ColorLevel].SelFieldColor;
  292.           sfSelFieldMono := Cfg.Color[ColorLevel].SelFieldMono;
  293.           sfFieldColor := Cfg.Color[ColorLevel].FieldColor;
  294.           sfFieldMono := Cfg.Color[ColorLevel].FieldMono;
  295.           sfProPromptColor := Cfg.Color[ColorLevel].ProPromptColor;
  296.           sfProPromptMono := Cfg.Color[ColorLevel].ProPromptMono;
  297.           sfSelPromptColor := Cfg.Color[ColorLevel].SelPromptColor;
  298.           sfSelPromptMono := Cfg.Color[ColorLevel].SelPromptMono;
  299.           sfPromptColor := Cfg.Color[ColorLevel].PromptColor;
  300.           sfPromptMono := Cfg.Color[ColorLevel].PromptMono;
  301.           EFP := EntryFieldPtr(dlNext);
  302.         END;
  303.       { Ændre tekst felter.... }
  304.       FillChar(CA, SizeOf(CA), Cfg.Color[ColorLevel].TextColor);
  305.       FillChar(MA, SizeOf(MA), Cfg.Color[ColorLevel].TextMono);
  306.       TFP := Pointer(ESR.asTextFields.Head);
  307.       while TFP <> nil do
  308.         with TFP^ do
  309.         begin
  310.           tfColorAttrs:=CA;
  311.           tfMonoAttrs :=MA;
  312.  
  313.           {follow link}
  314.           TFP := Pointer(TFP^.slNext);
  315.         end;
  316.  
  317.     END;
  318.  
  319.   VAR
  320.     i : LongInt;
  321.     Offset : Byte;
  322.   BEGIN
  323.     ResLib.GetEntry('ESR'+To3(ENr),Esr);
  324.     i:=ResLib.GetStatus;
  325.     IF i<>0 THEN
  326.     BEGIN
  327.       AddLog('!','GetESR: Error '+Long2Str(i)+' in '+Long2Str(Enr));
  328.       Halt(255);
  329.     END;
  330.     WITH Cfg.Color[ColorLevel],ESR DO
  331.     BEGIN
  332.       ResetHeaderColor(HeaderColor, HeaderMono);
  333.       ResetShadowColor(ShadowColor, ShadowMono);
  334.       wFrame.frFrameColor := FrameColor;
  335.       wFrame.frFrameMono := FrameMono;
  336.       SetTextAttr(TextColor,TextMono);
  337.       esFieldOptionsOn(efClearFirstChar);
  338.       SetWrapMode(WrapAtEdges);
  339.     END;
  340.     ResetEsrColors ;
  341.     IF Cfg.Screen.ExplodingWin THEN Esr.EnableExplosions(10) ELSE Esr.EnableNormalOpen;
  342.     EntryCommands.SetHelpProc(HelpRoutine);
  343. {   ESR.Draw;}
  344.     ESR.UpdateScreenSize;
  345.     Offset:=(ScreenWidth-80) DIV 2;
  346.     ESR.AdjustWindow(2+Offset,3,79+Offset,ScreenHeight-3);
  347.     Topic:=0 ;
  348.   END;
  349.  
  350. END.
  351.  
  352.